home *** CD-ROM | disk | FTP | other *** search
/ Kompuutteri Kaikille K-CD 2002 #1 / K-CD_2002-01.iso / Delphi / INSTALL / program files / Borland / Delphi6 / Demos / ResXplor / RXMisc.pas < prev    next >
Pascal/Delphi Source File  |  2001-05-22  |  3KB  |  109 lines
  1. unit RXMisc;
  2.  
  3. interface
  4.  
  5. uses Windows, Forms, Controls;
  6.  
  7. type
  8.   TSplitControl = class
  9.   private
  10.     FForm: TForm;
  11.     FSplitControl, FSizeTarget: TControl;
  12.     FVertical: Boolean;
  13.     FSplit: TPoint;
  14.     function GetSizing: Boolean;
  15.     procedure DrawSizingLine;
  16.   public
  17.     constructor Create(AForm: TForm);
  18.     procedure BeginSizing(ASplitControl, ATargetControl: TControl);
  19.     procedure ChangeSizing(X, Y: Integer);
  20.     procedure EndSizing;
  21.     property Sizing: Boolean read GetSizing;
  22.   end;
  23.  
  24. implementation
  25.  
  26. uses Graphics, SysUtils, Classes;
  27.  
  28. function CToC(C1, C2: TControl; P: TPoint): TPoint;
  29. begin
  30.   Result := C1.ScreenToClient(C2.ClientToScreen(P));
  31. end;
  32.  
  33. { TSplitControl }
  34.  
  35. constructor TSplitControl.Create(AForm: TForm);
  36. begin
  37.   FForm := AForm;
  38. end;
  39.  
  40. function TSplitControl.GetSizing: Boolean;
  41. begin
  42.   Result := FSplitControl <> nil;
  43. end;
  44.  
  45. procedure TSplitControl.DrawSizingLine;
  46. var
  47.   P: TPoint;
  48. begin
  49.   P := CToC(FForm, FSplitControl, FSplit);
  50.   with FForm.Canvas do
  51.   begin
  52.     MoveTo(P.X, P.Y);
  53.     if FVertical then
  54.       LineTo(CToC(FForm, FSplitControl, Point(FSplitControl.Width, 0)).X, P.Y) else
  55.       LineTo(P.X, CToC(FForm, FSplitControl, Point(0, FSplitControl.Height)).Y)
  56.   end;
  57. end;
  58.  
  59. procedure TSplitControl.BeginSizing(ASplitControl, ATargetControl: TControl);
  60. begin
  61.   FSplitControl := ASplitControl;
  62.   FSizeTarget := ATargetControl;
  63.   SetCaptureControl(FSplitControl);
  64.   FVertical := ASplitControl.Width > ASplitControl.Height;
  65.   if FVertical then
  66.     FSplit := Point(0, ASplitControl.Top) else
  67.     FSplit := Point(ASplitControl.Left, 0);
  68.   FForm.Canvas.Handle := GetDCEx(FForm.Handle, 0, DCX_CACHE or DCX_CLIPSIBLINGS
  69.     or DCX_LOCKWINDOWUPDATE);
  70.   with FForm.Canvas do
  71.   begin
  72.     Pen.Color := clWhite;
  73.     if FVertical then
  74.       Pen.Width := ASplitControl.Height else
  75.       Pen.Width := ASplitControl.Width;
  76.     Pen.Mode := pmXOR;
  77.   end;
  78.   DrawSizingLine;
  79. end;
  80.  
  81. procedure TSplitControl.ChangeSizing(X, Y: Integer);
  82. begin
  83.   DrawSizingLine;
  84.   if FVertical then FSplit.Y := Y else FSplit.X := X;
  85.   DrawSizingLine;
  86. end;
  87.  
  88. procedure TSplitControl.EndSizing;
  89. var
  90.   DC: HDC;
  91.   P: TPoint;
  92. begin
  93.   DrawSizingLine;
  94.   P := CToC(FSizeTarget, FSplitControl, FSplit);
  95.   SetCaptureControl(nil);
  96.   FSplitControl := nil;
  97.   with FForm do
  98.   begin
  99.     DC := Canvas.Handle;
  100.     Canvas.Handle := 0;
  101.     ReleaseDC(Handle, DC);
  102.   end;
  103.   if FVertical then
  104.     FSizeTarget.Height := P.Y else
  105.     FSizeTarget.Width  := P.X;
  106. end;
  107.  
  108. end.
  109.